home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SHELSURF.INC < prev    next >
Text File  |  1991-09-25  |  3KB  |  79 lines
  1. procedure SWAPSURF(I, J: word; var Surfmin, Surfmax: surfaces);
  2.  
  3. { Swap the data for surfaces I and J }
  4. var Vert: word;                 { vertex number }
  5.     Vert1, Vert2: word;         { vertices to swap }
  6.  
  7. begin
  8. {$ifdef BIGMEM}
  9. with ptrg^ do with ptrh^ do with ptri^ do
  10. begin
  11. {$endif}
  12.  
  13.   { The next several stmts. perform the exchange on I and J }
  14.   swapreal (Surfmax[I], Surfmax[J]);
  15.   swapreal (Surfmin[I], Surfmin[J]);
  16.   swapint  (Matl[I], Matl[J]);
  17.   swapint  (Nvert[I], Nvert[J]);
  18.   { Swap all the vertices }
  19.   Vert1 := (I-1)*Maxvert + 1;
  20.   Vert2 := (J-1)*Maxvert + 1;
  21.   for Vert := 1 to Maxvert do begin
  22.     swapword (Connect[Vert1], Connect[Vert2]);
  23.     Vert1 := Vert1 + 1;
  24.     Vert2 := Vert2 + 1;
  25.   end;
  26. {$ifdef BIGMEM}
  27. end; {with}
  28. {$endif}
  29. end;  { Procedure SWAPSURF }
  30.  
  31. procedure SHELSURF (var Surfmin, Surfmax: surfaces; Nsurf: word);
  32.  
  33. { Shell sort the surface data, using Surfavg as the primary sorting
  34.   criterion and Surfmin as the secondary (tie-breaking) sorting
  35.   criterion. Procedure as published in Tanenbaum, "Structured
  36.   Computer Organization", Prentice-Hall, Englewood Cliffs, NJ, 1976.
  37. }
  38. var Dist: word;                 { sorting distance }
  39.     K, I: word;                 { genl sorting indexes }
  40.     Done: boolean;              { finished inner loop yet? }
  41.  
  42. begin
  43.  
  44. { Determine the initial value of Dist by finding the largest power
  45.   of 2 less than Nsurf, and subtracting 1 from it. The final step in
  46.   this calculation is performed inside the main sorting loop.
  47. }
  48.   Dist := 4;
  49.   while (Dist < Nsurf) do
  50.     Dist := Dist + Dist;
  51.   Dist := Dist - 1;
  52.  
  53. { Main sorting loop. The outer loop is executed once per pass. }
  54.   while (Dist > 1) do begin
  55.     Dist := Dist div 2;
  56.     for K := 1 to (Nsurf - Dist) do begin
  57.       I := K;
  58.       Done := FALSE;
  59.       while (not Done) do begin
  60.         { This stmt. is the comparison. It also controls moving values
  61.           upward after an exchange. }
  62.         if (Surfmax[I] > Surfmax[I+Dist]) or ((Surfmax[I] = Surfmax[I+Dist])
  63.             and (Surfmin[I] > Surfmin[I+Dist])) then
  64.           swapsurf(I, I+Dist, Surfmin, Surfmax)
  65.         else
  66.           Done := TRUE;
  67.         { KVC 09/14/91 Added check because negative numbers not possible
  68.           when using words instead of integers.
  69.         }
  70.         if (Dist >= I) then
  71.           Done := TRUE
  72.         else
  73.           I := I - Dist;
  74.       end; { while }
  75.     end; { for K }
  76.   end; { while Dist }
  77.  
  78. end; { procedure SHELSURF }
  79.